home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 2339.ZIP / EXAMPLE.PRG < prev    next >
Text File  |  1988-09-06  |  13KB  |  413 lines
  1. * WALK THROUGH FOR GENERATED CODE FROM DRMENGEN
  2.  
  3.  
  4. * EXAMPLE   .PRG
  5. * 88.09.02
  6. * BHH
  7. * COPYRIGHT 88.09.02  ALL RIGHTS RESERVED
  8. ****************
  9. SET SCOREBOARD OFF
  10. SET TALK OFF
  11. SET BELL OFF
  12. SET CONFIRM OFF
  13. ********************************************************************
  14. *********   ALL PUBLIC VARIABLES FOR THE MENU ARE SET HERE *********
  15. *********   THIS IS A GOOD PLACE TO CALL A ROUTINE TO SET  *********
  16. *********   PUBLIC VARIABLES FOR YOUR APPLICATION          *********
  17. ********************************************************************
  18. SCLIPPER = .T.
  19. SDONE = .F.
  20. SY_END = "N"
  21. *********************************************************************
  22. ******** ONLY NEED TO CHANGE THE FOLLOWING VARIABLES ****************
  23. ******** AND THE STRING VARIABLES IN THE PROCEDURES  ****************
  24. ******** MENUSET, MENUHEAD, AND CORROSPONDING DROPS  ****************
  25. *********************************************************************
  26. SNUMMENUS = 4
  27. SMENULINE = 1
  28. SLINE = SMENULINE + 2
  29. SOFFSET = 2
  30. SDTSTAMP = 0
  31. SMENUWIDTH = 20
  32. SNUMOPT0 =  3
  33. SNUMOPT1 =  2
  34. SNUMOPT2 =  4
  35. SNUMOPT3 =  4
  36. SCOLORBG = "G+R/BG"
  37. SCOLORMH = "R+W/BR"
  38. SCOLORMB = "R B/N, G+R/B"
  39. SCOLORMM = "R+W/B"
  40. SET COLOR TO &SCOLORBG
  41. CLEAR
  42. CALL CURSOFF
  43. **********************************************************
  44. ***************** CALLS PROCEDURES TO WRITE HEADING,******
  45. ***************** MENUBAR AND SET STRING VARIABLES  ******
  46. ***************** FOR MENU ITEMS                    ******
  47. **********************************************************
  48. DO MENUHEAD
  49. DO MENUSET
  50. DO MENUBAR
  51. ***********************************************************
  52. ***************** MAIN LOOP *******************************
  53. ***********************************************************
  54. DO WHILE .T.
  55.    *****
  56.    DO WHILE .NOT. SDONE
  57.       SKEYPRESS = 0
  58.       @ SDTSTAMP,2 SAY DATE()
  59.       DO WHILE SKEYPRESS = 0
  60.          SET COLOR TO &SCOLORMB
  61.          @ SDTSTAMP,70 SAY TIME()
  62.          SET COLOR TO &SCOLORMB
  63.          SKEYPRESS = INKEY()
  64.       ENDDO ( SKEYPRESS )
  65.       SET COLOR TO &SCOLORMB
  66.       ***********************************************************
  67.       **************** MENU LOOP  *******************************
  68.       ***** MENUMODE = 0 FOR MENUBAR, = 1 WHEN DROP MENUS ON ****
  69.       ***********************************************************
  70.       DO CASE
  71.          CASE SKEYPRESS = 336 .OR. SKEYPRESS = 328
  72.               IF SMENUMODE = 0
  73.               ************  TO SCROLL PAST LEFT AND RIGHT LIMITS
  74.               ************  RESETS WHAT THE ACTIVE COLUMN IS
  75.               ***************************************************
  76.               ELSE
  77.               ************  LIKE ABOVE FOR DROPPED MENUS EXCEPT
  78.               ************  FOR UP AND DOWN LIMITS
  79.               ***************************************************
  80.               LOOP
  81.  
  82.          CASE SMENUMODE = 0 .AND. SKEYPRESS = 4 .OR. SMENUMODE = 0 .AND. SKEYPRESS = 19
  83.               ************  CHANGE ACTIVE COLUMN ON MENUBAR IN RESPONSE
  84.               ************  TO <- AND ->
  85.               ****************************************************
  86.               LOOP
  87.  
  88.          CASE SMENUMODE = 0 .AND. SKEYPRESS = 13
  89.               SDROPIT = "SDROP" +STR(SCHCOL,1)
  90.               ************* DROPS MENU WITH ENTER KEY PRESSED
  91.               ***********************************************
  92.               DO &SDROPIT
  93.               LOOP
  94.  
  95.          CASE SMENUMODE = 1 .AND. SKEYPRESS = 4 .OR. SMENUMODE = 1 .AND. SKEYPRESS = 19
  96.               ************ SWITCH DROPPED MENUS ON <- OR -> KEY PRESS
  97.               ************************************************
  98.               * ERASE OLD
  99.  
  100.               DO &SDROPIT
  101.               LOOP
  102.  
  103.          CASE SMENUMODE = 1 .AND. SKEYPRESS = 24 .OR. SMENUMODE = 1 .AND. SKEYPRESS = 5
  104.               ************* UP OR DOWN MOVEMENT ON DROPPED MENUS
  105.               ************************************************
  106.               LOOP
  107.  
  108.          CASE SMENUMODE = 0 .AND. SKEYPRESS >= 48 .AND. SKEYPRESS < (48 + SNUMMENUS)
  109.               ************* DROPS MENU ON KEY PRESS
  110.               *************************************************
  111.               DO &SDROPIT
  112.               LOOP
  113.  
  114.          CASE SMENUMODE = 1 .AND. SKEYPRESS >= 48 .AND. SKEYPRESS < (48 + SNUMOPT) .OR. SMENUMODE = 1 .AND. SKEYPRESS = 13
  115.               ************* LEAVES MENU LOOP ON SELECTION BY KEYPRESS
  116.               ************* OR WHEN ENTER KEY IS PRESSED
  117.               *************************************************
  118.               SMENUMODE = 0
  119.               SCHOICE = SSOPT
  120.               CLEAR GETS
  121.               EXIT
  122.  
  123.          CASE SMENUMODE = 1 .AND. SKEYPRESS = 27
  124.               ************* CLEARS DROPPED MENU, RETURNS TO MENUMAR
  125.               **************************************************
  126.               SMENUMODE = 0
  127.               LOOP
  128.  
  129.          OTHERWISE
  130.               ************* TRAPS WRONG KEYPRESS
  131.               ***************************************************
  132.               ?? CHR(7)
  133.               SKEYPRESS = 0
  134.               LOOP
  135.  
  136.       ENDCASE
  137.       **********************************************************
  138.       ************** END MENU LOOP *****************************
  139.       **********************************************************
  140.  
  141.       IF SCHOICE >= 1 .AND. SCHOICE <= SNUMOPT&SCHCOL
  142.          SSOPT = SCHOICE
  143.          SDONE = .T.
  144.       ENDIF
  145.    ENDDO ( SDONE )
  146.    SET COLOR TO &SCOLORBG
  147.    @ SMENULINE+2,0 CLEAR TO 14,79
  148.    SSUBCH = "SSOPT"+STR(SCHCOL,1)+STR(SSOPT,1)
  149.    SSUBCH = TRIM(SSUBCH)
  150.    **********************
  151.    DO CASE
  152.       CASE SSUBCH = "SSOPT00"
  153.            SAVE SCREEN
  154.            DO MESSOUT2 WITH "ARE YOU SURE YOU WANT TO QUIT ? (Y/N) : "
  155.            SET CONFIRM OFF
  156.            CALL CURSON
  157.            @ 23,RECOL2 GET SY_END PICTURE "A"
  158.            READ
  159.            SET COLOR TO &SCOLORBG
  160.            IF UPPER(SY_END) = "Y"
  161.               CLEAR
  162.               EXIT
  163.            ELSE
  164.               CALL CURSOFF
  165.               RESTORE SCREEN
  166.               @ SMENULINE+1,0 CLEAR TO SMENULINE+1,79
  167.               SET COLOR TO &SCOLORMB
  168.               @ SMENULINE,SMENUWIDTH*SCHCOL GET &SSELOLD
  169.               CLEAR GETS
  170.               SDONE = .F.
  171.            ENDIF
  172.       *********************************************************
  173.       ****************  SUB ROUTINE CALLING LOOP **************
  174.       ************ REMOVE '**' MARKED CALLS TO RUN ************
  175.       *********************************************************
  176.       CASE SSUBCH = "SSOPT01"
  177.            DO STARTIT
  178.            DO LOADDATA
  179.            DO FINISH1
  180.  
  181.       CASE SSUBCH = "SSOPT02"
  182.            DO STARTIT
  183.            DO LOADINDX
  184.            DO FINISH1
  185.  
  186.  
  187.       CASE SSUBCH = "SSOPT10"          * SAME AS FOR "SSOPT01 OR SSOPT02"
  188.  
  189.       CASE SSUBCH = "SSOPT11"
  190.  
  191.       CASE SSUBCH = "SSOPT20"
  192.  
  193.       CASE SSUBCH = "SSOPT21"
  194.  
  195.       CASE SSUBCH = "SSOPT22"
  196.  
  197.       CASE SSUBCH = "SSOPT23"
  198.  
  199.       CASE SSUBCH = "SSOPT30"
  200.  
  201.       CASE SSUBCH = "SSOPT31"
  202.  
  203.       CASE SSUBCH = "SSOPT32"
  204.  
  205.       CASE SSUBCH = "SSOPT33"
  206.  
  207.       OTHERWISE
  208.           SMENUMODE = 0
  209.           SDONE = .F.
  210.    ENDCASE
  211. ENDDO
  212. **********************
  213. CALL CURSON
  214. CLEAR ALL
  215. SET TALK ON
  216. SET BELL ON
  217. SET CONFIRM ON
  218. RETURN
  219. ************************************************************************
  220. ***************** PROGRAM END ******************************************
  221. ************************************************************************
  222.  
  223. THE FOLLOWING ROUTINES WILL BE IN A PROCEDURE FILE "MENUPROC.PRG" IF
  224. CLIPPER IS NOT SELECTED
  225.  
  226.  
  227.  
  228. *********************************
  229. ***** DROP SUBMENU ROUTINES *****
  230. *********************************
  231. PROCEDURE SDROP0
  232. SET COLOR TO &SCOLORMB
  233. @ SMENULINE,SCHCOL*SMENUWIDTH GET SMOPT0
  234. @ SMENULINE+SOFFSET,SCHCOL*SMENUWIDTH GET SSSOPT00
  235. @ SMENULINE+SOFFSET+1,SCHCOL*SMENUWIDTH SAY SSSOPT01
  236. @ SMENULINE+SOFFSET+2,SCHCOL*SMENUWIDTH SAY SSSOPT02
  237. CLEAR GETS
  238. RETURN
  239.  
  240. PROCEDURE SDROP1       * LIKE ABOVE
  241.  
  242. PROCEDURE SDROP2
  243.  
  244. PROCEDURE SDROP3
  245.  
  246.  
  247. PROCEDURE STARTIT
  248.   ****************************************************
  249.   ***************** PRECEEDS ALL SUBROUTINES  ********
  250.   ***************** CAN CALL CURSON HERE OR   ********
  251.   ****************  DEEPER IN CALLED ROUTINE  ********
  252.   ****************  COVERS CLOCK DISPLAY      ********
  253.   ****************************************************
  254.   CALL CURSON
  255.   SET COLOR TO &SCOLORBG
  256.   @ SMENULINE+2,0 CLEAR TO 24,79
  257.   SET COLOR TO &SCOLORMH
  258.   @ SDTSTAMP,70 SAY "        "
  259.   SET COLOR TO &SCOLORMB
  260. RETURN
  261. *******************************************************
  262. ************ THESE FOLLOW CALLED SUBROUTINES **********
  263. ************ FINISH1 CLEARS BELOW MENULINE   **********
  264. ************ FINISH2 CLEARS THE WHOLE SCREEN **********
  265. *******************************************************
  266. PROCEDURE FINISH1
  267.   CALL CURSOFF
  268.   SET COLOR TO &SCOLORBG
  269.   @ SMENULINE+1,0 CLEAR TO 24,79
  270.   SET COLOR TO &SCOLORMB
  271.   @ SMENULINE,SMENUWIDTH*SCHCOL GET &SSELOLD
  272.   CLEAR GETS
  273.   DONE = .F.
  274. RETURN
  275.  
  276. PROCEDURE FINISH2
  277.   CALL CURSOFF
  278.   SET COLOR TO &SCOLORBG
  279.   CLEAR
  280.   DO MENUHEAD
  281.   DO MENUBAR
  282.   SET COLOR TO &SCOLORMB
  283.   @ SMENULINE,SMENUWIDTH*SCHCOL GET &SSELOLD
  284.   CLEAR GETS
  285.   DONE = .F.
  286. RETURN
  287. *********************************************************
  288. ****************  MESSAGE PROCEDURES ********************
  289. *********************************************************
  290. PROCEDURE MESSOUT
  291.   PARAMETERS MESSCOM
  292.   RECOL = 46 + LEN(TRIM(MESSCOM))
  293.   SET COLOR TO &SCOLORMM
  294.   @ 22,45 CLEAR TO 24,RECOL
  295.   @ 22,45 TO 24,RECOL DOUBLE
  296.   @ 23,46 SAY MESSCOM
  297. RETURN
  298.  
  299. PROCEDURE MESSOUT1
  300.   PARAMETERS MESSCOM
  301.   RECOL = 46 + LEN(TRIM(MESSCOM))
  302.   SET COLOR TO &SCOLORMM
  303.   @ 22,45 CLEAR TO 24,RECOL
  304.   @ 22,45 TO 24,RECOL DOUBLE
  305.   @ 23,46 SAY MESSCOM
  306. RETURN
  307.  
  308. PROCEDURE MESSOUT2
  309.   PARAMETERS MESSCOM2
  310.   RECOL1 = 4 + LEN(TRIM(MESSCOM2))
  311.   PUBLIC RECOL2
  312.   RECOL2 = RECOL1 - 1
  313.   SET COLOR TO &SCOLORMM
  314.   @ 22,1 CLEAR TO 24,RECOL1
  315.   @ 22,1 TO 24,RECOL1 DOUBLE
  316.   @ 23,2 SAY MESSCOM2
  317. RETURN
  318.  
  319. *********************
  320. PROCEDURE MENUHEAD
  321.          SET COLOR TO &SCOLORMH
  322.   @ 0,0 CLEAR TO SMENULINE-1,79
  323.   *******************************************************
  324.   *****************  MAIN HEADING GOES HERE *************
  325.   *******************************************************
  326.   @ 0,20 SAY "   THIS IS A TEST HEADING FOR TEST1     "
  327.   SET COLOR TO W+/g
  328.   @ 15,14 CLEAR TO 24,59
  329.   @ 15,14 TO 24,59 DOUBLE
  330.   @ 16,16 SAY 'Highlight MENU option by using ' + CHR(26) + ' or ' + CHR(27)
  331.   @ 17,16 SAY 'and press '+ CHR(17) + CHR(217) + ' or appropiate menu number '
  332.   @ 19,16 SAY 'Highlight SUBMENU option by using ' + CHR(24) + ' or ' + CHR(25)
  333.   @ 20,16 SAY 'and press '+ CHR(17) + chr(217) + ' or appropiate option number '
  334.   @ 21,16 SAY 'To scroll between MENUS use ' + CHR(26) + ' or ' + CHR(27)
  335.   @ 23,16 SAY 'To return to MENU line press the Esc key '
  336.   SET COLOR TO &SCOLORMB
  337.  
  338. RETURN
  339.  
  340. *********************************************************
  341. *************** DRAW MENUBAR ****************************
  342. *********************************************************
  343. PROCEDURE MENUBAR
  344.   SET COLOR TO &SCOLORMB
  345.   @ SMENULINE,0 CLEAR TO SMENULINE,79
  346.   SMCNTR = 0
  347.   DO WHILE SMCNTR < SNUMMENUS
  348.      SMENUFD = "SMOPT"+STR(SMCNTR,1)
  349.      SMENUITEM = &SMENUFD
  350.      @ SMENULINE,SMCNTR*SMENUWIDTH SAY SMENUITEM
  351.      SMCNTR = SMCNTR + 1
  352.   ENDDO
  353.   SMENUFD = "SMOPT"+STR(SCHCOL,1)
  354.   SMENUITEM = &SMENUFD
  355.   @ SMENULINE,SCHCOL*SMENUWIDTH GET SMENUITEM
  356.   CLEAR GETS
  357. RETURN
  358.  
  359. **********************************************************
  360. ***********  SET STRINGS TO BE DISPLAYED *****************
  361. **********************************************************
  362. PROCEDURE MENUSET
  363.   PUBLIC SMOPT0,NUMOPT4
  364.   PUBLIC SMOPT1,NUMOPT4
  365.   PUBLIC SMOPT2,NUMOPT4
  366.   PUBLIC SMOPT3,NUMOPT4
  367.   PUBLIC SSSOPT00,SSOPT00
  368.   PUBLIC SSSOPT01,SSOPT01
  369.   PUBLIC SSSOPT02,SSOPT02
  370.   PUBLIC SSSOPT10,SSOPT10
  371.   PUBLIC SSSOPT11,SSOPT11
  372.   PUBLIC SSSOPT20,SSOPT20
  373.   PUBLIC SSSOPT21,SSOPT21
  374.   PUBLIC SSSOPT22,SSOPT22
  375.   PUBLIC SSSOPT23,SSOPT23
  376.   PUBLIC SSSOPT30,SSOPT30
  377.   PUBLIC SSSOPT31,SSOPT31
  378.   PUBLIC SSSOPT32,SSOPT32
  379.   PUBLIC SSSOPT33,SSOPT33
  380.   SMOPT0 = " 0. FILES   "
  381.   SMOPT1 = " 1. EDIT    "
  382.   SMOPT2 = " 2. REPORTS "
  383.   SMOPT3 = " 3. MAINT   "
  384.   SSSOPT00 = " 0. EXIT       "
  385.   SSOPT00 = "    EXIT    "
  386.   SSSOPT01 = " 1. DATABASES  "
  387.   SSOPT01 = "LOADDATA"
  388.   SSSOPT02 = " 2. INDEXES    "
  389.   SSOPT02 = "LOADINDX"
  390.   SSSOPT10 = " 0. EDIT DATA  "
  391.   SSOPT10 = "EDITDATA"
  392.   SSSOPT11 = " 1. EDIT REPT  "
  393.   SSOPT11 = "EDITRPTS"
  394.   SSSOPT20 = " 0. YTD TRANS  "
  395.   SSOPT20 = "YTDRPT  "
  396.   SSSOPT21 = " 1. MTD TRANS  "
  397.   SSOPT21 = "MTDRPT  "
  398.   SSSOPT22 = " 2. VENDERS    "
  399.   SSOPT22 = "VENRPT  "
  400.   SSSOPT23 = " 3. CUSTOMERS  "
  401.   SSOPT23 = "CUSRPT  "
  402.   SSSOPT30 = " 0. BACK UP    "
  403.   SSOPT30 = "BACKUPFL"
  404.   SSSOPT31 = " 1. RESTORE    "
  405.   SSOPT31 = "RESTFILE"
  406.   SSSOPT32 = " 2. RE-INDEX   "
  407.   SSOPT32 = "INDXFILE"
  408.   SSSOPT33 = " 3. IN/OUT     "
  409.   SSOPT33 = "INOUTFLS"
  410. RETURN
  411. ************************************************************************
  412. ************************ END *******************************************
  413. ************************************************************************